home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mthelp.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  9.8 KB  |  285 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtHelp;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *-----------+----------+------+----------------------------------------*)
  29.  
  30.  
  31.  
  32. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  33. (*                                              *)
  34. (*$R-   Range-Checks                            *)
  35. (*$S-   Stack-Check                             *)
  36. (*                                              *)
  37. (*----------------------------------------------*)
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  45.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  46.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  47.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  48.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  49.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  50.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  51.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58. FROM SYSTEM             IMPORT  ADR, ADDRESS;
  59. FROM mtAppl             IMPORT  MaxWidth, MaxHeight, MouseOn, MouseArrow,
  60.                                 MouseBusy, MouseOff, SetMouse, CharWidth,
  61.                                 CharHeight, BoxWidth, BoxHeight, PrivateWS;
  62. FROM mtPopups           IMPORT  StringPopup;
  63. FROM mtArea             IMPORT  AREA, NewAREA, DisposeAREA, SaveArea, RestoreArea;
  64. FROM mtTerminal         IMPORT  TERMINAL, Terminal, DeleteLine, Xpos, Ypos,
  65.                                 Width, Height, WriteChar, Attribute,
  66.                                 WriteLine, WriteConst, WriteLn, Attribut,
  67.                                 CursorOn, CursorOff, WrapOff, WrapOn,
  68.                                 ClearLine, ClearScreen, InversOn,
  69.                                 InversOff, SetAttribut, OpenTerminal,
  70.                                 CloseTerminal, ChangeTerminal, ClipRect;
  71. FROM mtTextfiles        IMPORT  TEXTFILE, READ, OpenTextfile, CloseTextfile,
  72.                                 Reset, EndofText, ReadChar, ReadLine, ReadLn,
  73.                                 ReadSpec, ReadCard, ReadInt;
  74. FROM mtUtils            IMPORT  tRect, ObjcFrame, CalcArea;
  75. FROM MagicStrings       IMPORT  Assign, Append, Equal, Length;
  76. FROM MagicAES           IMPORT  ShelFind, FormAlert, GrafHandle, OBJECT, 
  77.                                 TEDINFO, ObjcDraw, ObjcAdd, GBOX, GBOXTEXT,
  78.                                 WindGet, WFFULLXYWH;
  79.  
  80.  
  81. CONST   Cntrl =         '@';
  82.         Error =         '[3][|Fehler beim ™ffnen der Hilfsdatei][ABBRUCH]';
  83.  
  84. VAR     file:           TEXTFILE;
  85.         menu:           ARRAY [0..2] OF OBJECT;
  86.         title:          TEDINFO;
  87.         back:           AREA;
  88.         t, old:         TERMINAL;
  89.         init, exit:     BOOLEAN;
  90.         level:          sINTEGER;
  91.         tstr:           ARRAY [0..255] OF CHAR;
  92.         pop2:           ARRAY [0..40] OF CHAR;
  93.         r, br, scr:     tRect;
  94.  
  95.  
  96. PROCEDURE Schreibzeile (VAR in: ARRAY OF CHAR);
  97. VAR out:  ARRAY [0..255] OF CHAR;
  98.     i, j: sCARDINAL;
  99.     set:  Attribut;
  100.     d:    lCARDINAL;
  101.     x:    sINTEGER;
  102.  
  103.  PROCEDURE Attrib (bit: Attribute);
  104.  BEGIN
  105.   IF bit IN set THEN  EXCL (set, bit);  ELSE  INCL (set, bit);  END;
  106.   SetAttribut (set);
  107.  END Attrib;
  108.  
  109. BEGIN
  110.  i:= 0;  j:= 0;  set:= Attribut {};  exit:= FALSE;
  111.  LOOP
  112.   IF (in[i] = 0C) OR (i > HIGH(in)) THEN
  113.    EXIT;
  114.   ELSIF in[i] = '%' THEN
  115.    INC (i);
  116.    IF in[i] = '%' THEN
  117.     out[j]:= in[i];  INC (i);  INC (j);
  118.    ELSE 
  119.     out[j]:= 0C;  WriteLine (out);  j:= 0;
  120.     CASE CAP(in[i]) OF
  121.      'U': Attrib (underline);|
  122.      'F': Attrib (fat);|
  123.      'I': Attrib (italic);|
  124.      'H': Attrib (invers);|
  125.      'L': Attrib (light);|
  126.      'S': Attrib (superscript);|
  127.      'T': Attrib (subscript);|
  128.      'C': ClearScreen;|
  129.      'K': Assign ('  Weiter|  Hilfe abbrechen', pop2);
  130.           IF StringPopup (pop2, '') # 0 THEN  exit:= TRUE;  RETURN;  END;|
  131.      ELSE ;
  132.     END;
  133.     INC (i);
  134.    END;      
  135.   ELSE
  136.    out[j]:= in[i];  INC (i);  INC (j);
  137.   END;
  138.  END;
  139.  out[j]:= 0C;  WriteLine (out);  WriteLn;
  140. END Schreibzeile;
  141.  
  142.  
  143. PROCEDURE SetTitle (VAR str: ARRAY OF CHAR);
  144.  
  145. BEGIN
  146.  
  147.  Assign (str, tstr);  tstr[0]:= ' ';  Append (' ', tstr); 
  148. END SetTitle;
  149.  
  150.  
  151. PROCEDURE OpenWindow (VAR str: ARRAY OF CHAR; VAR x, y, s, z: sINTEGER);
  152. VAR b: BOOLEAN;
  153.     i,j,l: sINTEGER;
  154. BEGIN
  155.  SetTitle (str);
  156.  (*-- Basisobjekt --*)
  157.  WITH menu[0] DO
  158.   obNext:= -1;  obHead:= 1;  obTail:= 0;
  159.   obType:= GBOX;  obFlags:= {};  obState:= {};
  160.   obSpec.Box.char:= 0C;
  161.   obSpec.Box.frame:= 377C;
  162.   obSpec.Box.flags:= {Bit12, Bit11};
  163.   r.x:= x - 4;  obX:= r.x;  
  164.   r.y:= y - 4;  obY:= r.y;
  165.   r.w:= (s * CharWidth) + 4;
  166.   obWidth:= r.w;
  167.   r.h:= (z * CharHeight) + CharHeight + 4;
  168.   obHeight:= r.h;
  169.  END;
  170.  (*-- Titelzeile --*)
  171.  WITH menu[1] DO
  172.   obNext:= -1;  obHead:= -1;  obTail:= -1;
  173.   obType:= GBOXTEXT;  obFlags:= {};  obState:= {};
  174.   obSpec.TedPtr:= ADR (title);  
  175.   obX:= 0;  obY:= 0;  obWidth:= r.w;  obHeight:= CharHeight;
  176.  END;
  177.  ObjcAdd (ADR (menu), 0, 1);
  178.  WITH title DO
  179.   tePtext:= ADR (tstr);  tePtmplt:= ADR (tstr);  tePvalid:= ADR (tstr);
  180.   teFont:= 3;  teFontid:= 0;  teJust:= 2;  teColor:= 011A1H;
  181.   teFontsize:= 0;  teThickness:= -1;
  182.   teTxtlen:= Length (tstr);  teTmplen:= teTxtlen;
  183.  END;
  184.  INC (r.x);  r.y:= r.y + CharHeight + 2;
  185.  DEC (r.w, 2);  r.h:= r.h - CharHeight - 3;
  186.  t:= OpenTerminal (r);
  187.  old:= ChangeTerminal (t);
  188.  DEC (r.x);  DEC (r.y);  INC (r.w, 2);  INC (r.h, 2);
  189.  b:= NewAREA (back);
  190.  CalcArea (ADR(menu), 0, br);
  191.  b:= SaveArea (PrivateWS, back, br);
  192.  ObjcDraw (ADR (menu), 0, 8, br);
  193.  ClearScreen;  WrapOn;
  194. END OpenWindow;
  195.  
  196. PROCEDURE Help (name, selstring: ARRAY OF CHAR);
  197. (* Korrigierte Version von Steffen Engel *)
  198. VAR str, selectstring:    ARRAY [0..255] OF CHAR;
  199.     select: ARRAY [1..20],[0..20] OF CHAR;
  200.     pop:    ARRAY [0..450] OF CHAR;
  201.     b:      BOOLEAN;
  202.     i,j,k,l,s,x: sINTEGER;
  203.     ende    : BOOLEAN;
  204.  
  205. BEGIN
  206.   (* selstring in eigene Variable umspeichern, um damit arbeiten zu k”nnen *)
  207.   Assign(selstring, selectstring);
  208.  
  209.   (* Initialisierung *)
  210.   Assign(name, str);  ShelFind (str);
  211.   IF NOT OpenTextfile (str, READ, 1024, file) THEN
  212.    i:= FormAlert (1, Error);  RETURN;
  213.   END;
  214.   Reset (file);
  215.   ReadInt (file, i);  ReadInt (file, j);
  216.   ReadInt (file, k);  ReadInt (file, l);  ReadLn (file);
  217.   OpenWindow (selectstring, i, j, k, l);
  218.   ende := FALSE;
  219.   exit := FALSE;
  220.  
  221.   REPEAT  (* solange nach weiteren Hilfen gefragt wird *)
  222.    Reset(file);
  223.    (* Hilfe suchen *)
  224.    LOOP
  225.     IF EndofText (file) THEN  ende := TRUE; EXIT; END;
  226.     ReadLine (file, str);  ReadLn (file);
  227.     IF Equal (str, selectstring) THEN  EXIT;  END;
  228.    END;
  229.    IF ~ende
  230.      THEN
  231.        SetTitle (str);
  232.        ObjcDraw (ADR (menu), 0, 8, r);
  233.        ClearScreen;
  234.        (* Hilfstext ausgeben *)
  235.        LOOP
  236.         IF EndofText (file)
  237.           THEN
  238.             ende := TRUE;
  239.             EXIT;
  240.           END;
  241.         ReadLine (file, str);  ReadLn (file);
  242.         IF str[0] = '@' THEN  EXIT;  END;
  243.         Schreibzeile (str);
  244.         IF exit
  245.           THEN
  246.             ende := TRUE;
  247.             EXIT;
  248.           END;
  249.        END;
  250.        IF NOT exit THEN
  251.         pop[0]:= 0C;  s:= 1;  x:= 0;
  252.         LOOP
  253.          IF EndofText (file) THEN  ende := TRUE;  EXIT;  END;
  254.          ReadLine (file, str);  ReadLn (file);
  255.          IF str[0] = Cntrl THEN  EXIT;  END;
  256.          select[s]:= Cntrl;  Append (str, select[s]);  INC (s);
  257.          Append ('  ', pop);  Append (str, pop);  Append (' |', pop);
  258.         END;
  259.         IF ~ende
  260.           THEN
  261.             Append ('  Hilfe beenden', pop);
  262.             i:= StringPopup (pop, ' Weitere Hilfen ');
  263.             IF (i > 0) AND (i < s)
  264.               THEN
  265.                 Assign(select[i], selectstring);
  266.               ELSE
  267.                 ende := TRUE;
  268.               END;
  269.           END;
  270.      END;
  271.    END;
  272.   UNTIL ende;
  273.  
  274.   (* Bildschirm restaurieren *)
  275.   CloseTerminal (t);
  276.   t:= ChangeTerminal (old);
  277.   RestoreArea (PrivateWS, back);  DisposeAREA (back);
  278.   CloseTextfile (file);
  279. END Help;
  280.  
  281. BEGIN
  282.  init:= FALSE;
  283. END mtHelp.
  284.  
  285.